home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cocktail / cg.lha / cg / src / Errors.0 < prev    next >
Text File  |  1992-11-24  |  9KB  |  277 lines
  1. (* $Id: Errors.mi,v 1.0 1992/08/07 14:41:59 grosch rel $ *)
  2.  
  3. (* $Log: Errors.mi,v $
  4.  *)
  5.  
  6. (* Ich, Doktor Josef Grosch, Informatiker, Juli 1992 *)
  7.  
  8. IMPLEMENTATION MODULE Errors;
  9.  
  10. FROM SYSTEM    IMPORT ADDRESS, TSIZE, ADR;
  11. FROM Memory    IMPORT Alloc;
  12. FROM IO        IMPORT tFile, StdError, WriteC, WriteNl, WriteS, WriteI,
  13.                WriteB, WriteR, CloseIO;
  14. FROM Positions    IMPORT tPosition, Compare, WritePosition;
  15. FROM StringMem    IMPORT tStringRef, PutString, GetString;
  16. FROM Strings    IMPORT tString, ArrayToString, StringToArray;
  17. FROM Idents    IMPORT tIdent, WriteIdent, MakeIdent;
  18. FROM Sets    IMPORT tSet, WriteSet, Assign, MakeSet, Size;
  19. FROM Sort    IMPORT Sort;
  20.  
  21. IMPORT System, Strings;
  22.  
  23. CONST MaxError    = 300;
  24. # include "/tmp/cg/consts1"
  25. # include "/tmp/cg/consts2"
  26.  
  27. TYPE tArray    = ARRAY [0..255] OF CHAR;
  28.  
  29. TYPE tError    = RECORD
  30.                        Position    : tPosition    ;
  31.                        IsErrorCode    : BOOLEAN    ;
  32.                        ErrorNumber    : SHORTCARD    ;
  33.                        ErrorCode    : SHORTCARD    ;
  34.                        ErrorClass    : SHORTCARD    ;
  35.              CASE      InfoClass    : SHORTCARD    OF
  36.              | None    :
  37.              | Integer    : vInteger    : INTEGER    ;
  38.              | Short    : vShort    : SHORTCARD    ;
  39.              | Long    : vLong        : LONGINT    ;
  40.              | Real    : vReal        : REAL        ;
  41.              | Boolean    : vBoolean    : BOOLEAN    ;
  42.              | Character: vCharacter    : CHAR        ;
  43.              | String    : vString    : tStringRef    ;
  44.              | Array    : vArray    : tStringRef    ;
  45.              | Set    : vSet        : POINTER TO tSet;
  46.              | Ident    : vIdent    : tIdent    ;
  47.              END;
  48.           END;
  49.  
  50. VAR
  51.    ErrorTable    : ARRAY [0..MaxError] OF tError;
  52.    MessageCount    : INTEGER;
  53.    IsStore    : BOOLEAN;
  54.    HandleMessage: PROCEDURE (BOOLEAN, CARDINAL, CARDINAL, tPosition, CARDINAL, ADDRESS);
  55.    Out        : tFile;
  56.  
  57. PROCEDURE ErrorMessage    (ErrorCode, ErrorClass: CARDINAL; Position: tPosition);
  58.    BEGIN
  59.       HandleMessage (TRUE, ErrorCode, ErrorClass, Position, None, NIL);
  60.    END ErrorMessage;
  61.  
  62. PROCEDURE ErrorMessageI    (ErrorCode, ErrorClass: CARDINAL; Position: tPosition;
  63.              InfoClass: CARDINAL; Info: ADDRESS);
  64.    BEGIN
  65.       HandleMessage (TRUE, ErrorCode, ErrorClass, Position, InfoClass, Info);
  66.    END ErrorMessageI;
  67.  
  68. PROCEDURE Message  (ErrorText: ARRAY OF CHAR; ErrorClass: CARDINAL; Position: tPosition);
  69.    VAR String    : tString;
  70.    BEGIN
  71.       ArrayToString (ErrorText, String);
  72.       HandleMessage (FALSE, MakeIdent (String), ErrorClass, Position, None, NIL);
  73.    END Message;
  74.  
  75. PROCEDURE MessageI (ErrorText: ARRAY OF CHAR; ErrorClass: CARDINAL; Position: tPosition;
  76.              InfoClass: CARDINAL; Info: ADDRESS);
  77.    VAR String    : tString;
  78.    BEGIN
  79.       ArrayToString (ErrorText, String);
  80.       HandleMessage (FALSE, MakeIdent (String), ErrorClass, Position, InfoClass, Info);
  81.    END MessageI;
  82.  
  83. PROCEDURE WriteHead (Position: tPosition; ErrorClass: CARDINAL);
  84.    BEGIN
  85.       WritePosition (Out, Position);
  86.       WriteS    (Out, ": ");
  87.       CASE ErrorClass OF
  88.       |  Fatal        : WriteS (Out, "Fatal       ");
  89.       |  Restriction    : WriteS (Out, "Restriction ");
  90.       |  Error        : WriteS (Out, "Error       ");
  91.       |  Warning    : WriteS (Out, "Warning     ");
  92.       |  Repair        : WriteS (Out, "Repair      ");
  93.       |  Note        : WriteS (Out, "Note        ");
  94.       |  Information    : WriteS (Out, "Information ");
  95.       ELSE WriteS (Out, "Error class: "); WriteI (Out, ErrorClass, 0);
  96.       END;
  97.    END WriteHead;
  98.  
  99. PROCEDURE WriteCode (ErrorCode: CARDINAL);
  100.    BEGIN
  101.       CASE ErrorCode OF
  102.       |  NoText        :
  103.       |  SyntaxError    : WriteS (Out, "syntax error"        );
  104.       |  ExpectedTokens    : WriteS (Out, "expected tokens"    );
  105.       |  RestartPoint    : WriteS (Out, "restart point"        );
  106.       |  TokenInserted    : WriteS (Out, "token inserted "    );
  107.       |  WrongParseTable: WriteS (Out, "parse table mismatch"    );
  108.       |  OpenParseTable    : WriteS (Out, "cannot open parse table");
  109.       |  ReadParseTable    : WriteS (Out, "cannot read parse table");
  110.       |  TooManyErrors    : WriteS (Out, "too many errors"    );
  111. # include "/tmp/cg/writes1"
  112. # include "/tmp/cg/writes2"
  113.       ELSE WriteS (Out, " error code: "); WriteI (Out, ErrorCode, 0);
  114.       END;
  115.    END WriteCode;
  116.  
  117. PROCEDURE WriteInfo (InfoClass: CARDINAL; Info: ADDRESS);
  118.    VAR
  119.       PtrToInteger    : POINTER TO INTEGER;
  120.       PtrToShort    : POINTER TO SHORTCARD;
  121.       PtrToLong        : POINTER TO LONGINT;
  122.       PtrToReal        : POINTER TO REAL;
  123.       PtrToBoolean    : POINTER TO BOOLEAN;
  124.       PtrToCharacter    : POINTER TO CHAR;
  125.       PtrToString    : POINTER TO tString;
  126.       PtrToArray    : POINTER TO tArray;
  127.       PtrToSet        : POINTER TO tSet;
  128.       PtrToIdent    : POINTER TO tIdent;
  129.    BEGIN
  130.       IF InfoClass = None THEN RETURN; END;
  131.       WriteS (Out, ": ");
  132.       CASE InfoClass OF
  133.       | Integer    : PtrToInteger    := Info; WriteI (Out, PtrToInteger^, 0);
  134.       | Short      : PtrToShort    := Info; WriteI (Out, PtrToShort^, 0);
  135.       | Long       : PtrToLong    := Info; WriteI (Out, PtrToLong^, 0);
  136.       | Real       : PtrToReal    := Info; WriteR (Out, PtrToReal^, 1, 10, 1);
  137.       | Boolean    : PtrToBoolean    := Info; WriteB (Out, PtrToBoolean^);
  138.       | Character:PtrToCharacter:= Info; WriteC (Out, PtrToCharacter^);
  139.       | String    : PtrToString    := Info; Strings.WriteS (Out, PtrToString^);
  140.       | Array    : PtrToArray    := Info; WriteS (Out, PtrToArray^);
  141.       | Set    : PtrToSet    := Info; WriteSet (Out, PtrToSet^);
  142.       | Ident    : PtrToIdent    := Info; WriteIdent (Out, PtrToIdent^);
  143.       ELSE
  144.       END;
  145.    END WriteInfo;
  146.  
  147. PROCEDURE WriteMessage    (IsErrorCode: BOOLEAN; ErrorCode, ErrorClass: CARDINAL;
  148.              Position: tPosition; InfoClass: CARDINAL; Info: ADDRESS);
  149.    BEGIN
  150.       WriteHead (Position, ErrorClass);
  151.       IF IsErrorCode THEN
  152.      WriteCode (ErrorCode);
  153.       ELSE
  154.      WriteIdent (Out, ErrorCode);
  155.       END;
  156.       WriteInfo (InfoClass, Info);
  157.       WriteNl (Out);
  158.       IF (ErrorClass = Fatal) AND NOT IsStore THEN Exit; END;
  159.    END WriteMessage;
  160.  
  161. PROCEDURE WriteMessages    (File: tFile);
  162.    VAR i    : INTEGER;
  163.    VAR Info    : ADDRESS;
  164.    VAR s    : tString;
  165.    BEGIN
  166.       Sort (1, MessageCount, IsLess, Swap);
  167.       Out := File;
  168.       FOR i := 1 TO MessageCount DO
  169.      WITH ErrorTable [i] DO
  170.         CASE InfoClass OF
  171.         | Integer    : Info := ADR (vInteger    );
  172.         | Short    : Info := ADR (vShort    );
  173.         | Long    : Info := ADR (vLong    );
  174.         | Real    : Info := ADR (vReal    );
  175.         | Boolean    : Info := ADR (vBoolean    );
  176.         | Character    : Info := ADR (vCharacter);
  177.         | String    : GetString (vString, s); Info := ADR (s);
  178.         | Set    : Info :=      vSet     ;
  179.         | Ident    : Info := ADR (vIdent    );
  180.         ELSE
  181.         END;
  182.         WriteMessage (IsErrorCode, ErrorCode, ErrorClass, Position, InfoClass, Info);
  183.      END;
  184.       END;
  185.       Out := StdError;
  186.    END WriteMessages;
  187.  
  188. PROCEDURE StoreMessage    (pIsErrorCode: BOOLEAN; pErrorCode, pErrorClass: CARDINAL;
  189.              pPosition: tPosition; pInfoClass: CARDINAL; pInfo: ADDRESS);
  190.    VAR
  191.       PtrToInteger    : POINTER TO INTEGER    ;
  192.       PtrToShort    : POINTER TO SHORTCARD    ;
  193.       PtrToLong        : POINTER TO LONGINT    ;
  194.       PtrToReal        : POINTER TO REAL    ;
  195.       PtrToBoolean    : POINTER TO BOOLEAN    ;
  196.       PtrToCharacter    : POINTER TO CHAR    ;
  197.       PtrToString    : POINTER TO tString    ;
  198.       PtrToArray    : POINTER TO tArray    ;
  199.       PtrToSet        : POINTER TO tSet    ;
  200.       PtrToIdent    : POINTER TO tIdent    ;
  201.       s            : tString        ;
  202.    BEGIN
  203.       IF MessageCount < MaxError THEN
  204.      INC (MessageCount);
  205.      WITH ErrorTable [MessageCount] DO
  206.         Position    := pPosition    ;
  207.         IsErrorCode    := pIsErrorCode    ;
  208.         ErrorNumber    := MessageCount    ;
  209.         ErrorCode    := pErrorCode    ;
  210.         ErrorClass    := pErrorClass    ;
  211.         InfoClass    := pInfoClass    ;
  212.         CASE InfoClass OF
  213.         | Integer    : PtrToInteger    := pInfo; vInteger    := PtrToInteger    ^;
  214.         | Short    : PtrToShort    := pInfo; vShort    := PtrToShort    ^;
  215.         | Long    : PtrToLong    := pInfo; vLong        := PtrToLong    ^;
  216.         | Real    : PtrToReal    := pInfo; vReal        := PtrToReal    ^;
  217.         | Boolean    : PtrToBoolean    := pInfo; vBoolean    := PtrToBoolean    ^;
  218.         | Character    : PtrToCharacter:= pInfo; vCharacter    := PtrToCharacter^;
  219.         | String    : PtrToString    := pInfo; vString    := PutString (PtrToString^);
  220.         | Array    : PtrToArray    := pInfo; ArrayToString (PtrToArray^, s);
  221.               InfoClass    := String;vArray    := PutString (s);
  222.         | Set    : PtrToSet    := pInfo; vSet        := Alloc (TSIZE (tSet));
  223.                           MakeSet (vSet^, Size (PtrToSet^));
  224.                           Assign  (vSet^, PtrToSet^);
  225.         | Ident    : PtrToIdent    := pInfo; vIdent    := PtrToIdent    ^;
  226.         ELSE
  227.         END;
  228.      END;
  229.       ELSE
  230.      WITH ErrorTable [MessageCount] DO
  231.         IsErrorCode    := TRUE        ;
  232.         ErrorCode    := TooManyErrors;
  233.         ErrorClass    := Restriction    ;
  234.         InfoClass    := None        ;
  235.      END;
  236.       END;
  237.       IF pErrorClass = Fatal THEN WriteMessages (StdError); Exit; END;
  238.    END StoreMessage;
  239.  
  240. PROCEDURE IsLess (i, j: INTEGER): BOOLEAN;
  241.    VAR r: INTEGER;
  242.    BEGIN
  243.       r := Compare (ErrorTable [i].Position, ErrorTable [j].Position);
  244.       IF r = -1 THEN RETURN TRUE ; END;
  245.       IF r = +1 THEN RETURN FALSE; END;
  246.       RETURN ErrorTable [i].ErrorNumber < ErrorTable [j].ErrorNumber;
  247.    END IsLess;
  248.  
  249. PROCEDURE Swap (i, j: INTEGER);
  250.    VAR t: tError;
  251.    BEGIN
  252.       t := ErrorTable [i]; ErrorTable [i] := ErrorTable [j]; ErrorTable [j] := t;
  253.    END Swap;
  254.  
  255. PROCEDURE StoreMessages (Store: BOOLEAN);
  256.    BEGIN
  257.       IF Store THEN
  258.      HandleMessage := StoreMessage;
  259.      MessageCount  := 0;
  260.       ELSE
  261.      HandleMessage := WriteMessage;
  262.       END;
  263.       IsStore := Store;
  264.    END StoreMessages;
  265.  
  266. PROCEDURE yyExit;
  267.    BEGIN
  268.       CloseIO; System.Exit (1);
  269.    END yyExit;
  270.  
  271. BEGIN
  272.    Exit        := yyExit;
  273.    IsStore    := FALSE;
  274.    Out        := StdError;
  275.    HandleMessage:= WriteMessage;
  276. END Errors.
  277.